MacFormat 1996 January/macformat-033.iso/mac/Shareware City/Applications/State-Smart ƒ/Scripts/ßScripts/stack.txt

Text File | 1995-10-24 | 21.5 KB | 884 lines

-- stack: in
-- format: 10 (HyperCard 2)
-- flags: 0x1000 (none)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=64, y1=69, x2=576, y2=411)
-- screen: Rect(x1=0, y1=0, x2=640, y2=480)
-- card dimensions: w=512 h=342
-- scroll: x=0 y=0
-- background count: 1
-- first background id: 2710
-- card count: 1
-- first card id: 3040
-- list block id: 3975
-- print block id: 0
-- font table block id: 3517
-- style table block id: 3275
-- free block count: 2
-- free size: 7424 bytes
-- total size: 32768 bytes
-- stack block size: 19968 bytes
-- created by hypercard version: 0x02006043
-- compacted by hypercard version: 0x02008000
-- modified by hypercard version: 0x02008000
-- opened by hypercard version: 0x02308000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x8000000008000000
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0x8888222288882222
-- patterns[4]: 0x88AA22AA88AA22AA
-- patterns[5]: 0xCCAA33AACCAA33AA
-- patterns[6]: 0xEEAABBAAEEAABBAA
-- patterns[7]: 0xEEBBBBEEEEBBBBEE
-- patterns[8]: 0xFFBBFFEEFFBBFFEE
-- patterns[9]: 0xFFBBFFFFFFBBFFFF
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xC4800C6843023026
-- patterns[15]: 0xB130031BD8C00C8D
-- patterns[16]: 0xAA00AA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0xDE01303A
----- HyperTalk script -----
--Intellimation suggested routines ---
on unLockIt
  set the userlevel to 5
  show message
  show tool window at 40,20
end unLockIt

on LockIt
  global UL
  set the userlevel to UL
  hide message
  hide tool window
end LockIt

on uf --unlock fields
  TogFields unlock
end uf

on lf --lock fields
  TogFields lock
end lf

on TogFields arg
  if arg is "lock" then put true into tog else put false into tog
  put the number of bg flds into nbgf
  put the number of cd flds into ncdf
  repeat with i = 1 to nbgf
    set the lockText of bg fld i to tog
  end repeat
  repeat with i = 1 to ncdf
    set the lockText of cd fld i to tog
  end repeat
end TogFields



on doWindows
  put the number of lines of the windows into n
  repeat with i = 1 to n
    put line i of the windows
    wait until the mouseclick
  end repeat
end doWindows

on resumeStack
  global isinit
  if not(isinit is true) then initSS
  pass resumeStack
end resumeStack



on initSS

  --check the version
  if the version <2.0 then
    answer "this stack requires HyperCard version 2.0 or above" with "Continue" or "Go Home"
    if it is "Go Home" then go Home
  end if
  global isinit
  global ul,USRLVL
  if not (isinit is true) then
    --save the current userlevel
    put the userlevel into ul
    --initialize system globals
    lock screen
    push cd
    set the lockmessages to true
    go "§Control"
    put cd fld "globlist" of cd "help" into gl
    put the number of lines of gl into n
    get cd fld "memory" of cd "help"
    repeat with i = 1 to n
      put line i of gl into vr
      put "global " & vr into lin
      do lin
      put "put line " & i & " of it into " & vr into lin
      do lin
    end repeat

    --these globals aren't stored because the user can't change them
    global NUMREG, NUMCAT, NONO, NAMENO, SWNO, SONGNO, ATCNO, IDNO, NUMOPT
    put 6 into NUMREG
    put 13 into NUMCAT
    put 8 into NUMOPT
    put the number of cd btn "NO" of cd "US home" into NONO
    put the number of cd btn "SW" of cd "US home" into SWNO
    put the number of cd btn "NAME" of cd "US home" into NAMENO
    put the number of cd btn "SONG" of cd "US home" into SONGNO
    put the number of cd btn "ATC" of cd "US home" into ATCNO
    put the number of cd btn "Score Data" of cd "US home" into IDNO
    pop cd
    set the lockmessages to false
  end if



  --put OUR credits in the Apple menu
  put "About State-Smart..." into menuItem 1 of menu 1
  set the menuMsg of menuItem 1 of menu 1 to "About"


  --use the saved State-Smart user level
  if USRLVL <> ""then  set the userLevel to USRLVL

  --create the State-Smart menu
  if "State-Smart" is not in the menus then
    create menu "State-Smart"
    put "Print Map" & RETURN & "Export Map"& RETURN & "New Map" & RETURN & "-" & RETURN & "Quiz" & RETURN & "Sound" & RETURN & "Quiz Options" & RETURN & "Locate"& RETURN & "Locate Next"& RETURN & "Graph Data" & RETURN & "Palette" & RETURN & "New Password" & RETURN & "DeCrypt" into menu "State-Smart"
    enable menu "State-Smart"

    --now make the menu do what we want it to
    global snd
    if snd <> "" then set the checkMark of menuItem "Sound" of menu "State-Smart" to snd
    disable menuItem "New Map" of menu "State-Smart"
    put the number of menuItems of menu "State-Smart" into nit
    set the lockmessages to true
    push cd
    go "§Control"
    put cd fld "mumsgs" of first cd into temp
    pop cd
    set the lockmessages to false
    repeat with i = 1 to nit
      set the menuMsg of menuItem i of menu "State-Smart" to line i of temp
    end repeat
    set the cmdChar of menuItem "Locate" of menu "State-Smart" to L
    set the cmdChar of menuItem "Locate Next" of menu "State-Smart" to G
  end if
  global isinit
  put true into isinit  --we are initting now
  unlock screen
end initSS



on saveSS
  lock screen
  push cd
  set the lockmessages to true
  go "§Control"
  set the lockmessages to false
  put cd fld "globlist" of cd "help"  into gl
  put the number of lines of gl into n
  repeat with i = 1 to n
    put line i of gl into vr
    put "global " & vr into lin
    do lin
    put "put "& vr & " into line " & i & " of temp" into lin
    do lin
  end repeat
  put temp into card field "memory" of card "help"
  pop cd
  unlock screen
end saveSS



on doMenu x
  if (x is "Open Stack...") or  (x is "Go Home") or (x is "Close Stack") or (x is "New Stack...") or (x is "Quit HyperCard") then
    --because we don't want to do a complete reinit each time
    -- if "State-Smart" is in the menus then delete menu "State-Smart"
    --  if "Map Color" is in the menus then delete menu "Map Color"
    --  put "About HyperCard..." into menuItem 1 of menu 1
    --set the menuMsg of menuItem 1 of menu 1 to empty
    reset menubar
    saveSS --this is why we include Quit HyperCard
    global isinit
    put false into isinit
  end if
  pass doMenu
end doMenu

on About
  visual dissolve slow to cd
  go cd "About§" of stack "§Control"
end About

function stkn c
if c is "C" then return( "§Cities")
else if c is "T" then return("§Topography" )
else if c is "X" then return("§Contours")
else if c is "A" then return("§Cities")
else return( "§Control")
end stkn

on doGraph
  go first card of bg "Map Color BG" of stack "§Control"
  --nav --gets the general navigation palette up
end doGraph

on doPal
  --gets the appropriate palette window for current stack
  --in case it has been inadvertently closed
  put the short name of this stack into tsn
  if tsn is "§Topography" then put "TopNav" into tpn
  if tsn is "§Contours" then put "ContPal" into tpn
  if tsn is "§Cities" then put "CitPal" into tpn
  if tsn is "§Control" then put "SSNav" into tpn
  if tsn is "§User Guide" then put "Navigator" into tpn
  get the short name of this bg
  if it is "Map Color BG" then put "Navigator" into tpn
  if it contains "Region" then
    dispPal "Compass"
  end if
  dispPal tpn
end doPal

on dispPal pal
  put findxy(pal) into xy
  lock screen
  if pal is not in the windows then
    palette pal
  end if
  unlock screen
  if xy is not empty then
    show window pal at xy
  else
    show window pal
  end if
end dispPal


function findxy pal
--this is a workaround for a 2.0 bug where the
--value of a multi item object only evaluates
--to the first item.  I would have much preferred
--to do this inline and use value but it doesn't work
put "global "&pal&"Global" into line
do line
put "if "&pal&"Global is empty then put ""E&"0,0""E&" into ans" into line
do line   --empty if never used before
put "if "&pal&"Global is not empty then put "&pal&"Global into ans" into line
do line   --otherwise use old value
put "if "&pal&"Global is true then put ""E"E&" into ans" into line
do line   --true if already showing no need to redo
return ans
end findxy



on protect
  put the number of cds into n
  repeat with i = 1 to n
    set the cantDelete of cd i to TRUE
  end repeat
end protect

--handler for OFF-MAP buttons
on mouseDown
  put char 2 to 3 of word 3 of the target into s
  if s is "OM" then
    push cd
    go cd "ad"
  end if
end mouseDown

--handler for adjacent state buttons
--these buttons have no scripts so they fall through to here
on mouseUp
  put getEffect () into visef  --bases this on the clickloc
  put char 2 to 3 of word 3 of the target into xn
  if xn is "OM" then
    pop card
    exit mouseUp
  end if
  get the short name of this cd
  if char 1 of it is "A" then put "C" into char 1 of it
  put char 1 to 2 of it & xn into xn
  visual visef
  go card xn
end mouseUp

function getEffect  --for adjacent state buttons
put the clickV into cV
put the clickH into cH
put abs(cH - 256) into epsH
put abs(cV - 171) into epsV
if 1.5 * epsV ‚â• epsH then
  if cV ≤ 171 then
    put "Down" into direc
  else
    put "Up" into direc
  end if
else
  if cH ≤ 256 then
    put "Right" into direc
  else
    put "Left" into direc
  end if
end if
return "scroll" && direc && "slow"
end getEffect


on doSound
  set the checkMark of menuItem "Sound" of menu "State-Smart" to not (the checkMark of menuItem "Sound" of menu "State-Smart")
  global snd
  put not(snd) into snd
end doSound


on doKillQ
  global QINP
  answer "Abandon Quiz?" with "OK" or "Cancel"
  if it is "OK" then
    put false into QINP
    put empty into QinpCard
    cleanUp
  end if
end doKillQ

on cleanUp
  global fname
  if the short name of this bg is not "Info" then
    cleanUSHome
    --it must be the USA so make sure all the map stuff is showing
  else
    lock screen
    hide bg field "Quiz field"
    hide bg btn "Abort"
    repeat with i = 1 to 4
      put "Answer"&i into bn
      put "Question"&i into fn
      hide field fn
      hide bg button bn
    end repeat
    if fname is not empty then show bg field fname
    show window "SSNav"
    unlock screen
  end if
end cleanUp


on doPrint
  doMenu "Print Card"
end doPrint

on doExport
  --put "§" & the short name of this card into nn
  set the userlevel to 4
  --export paint to file nn
  --answer "Exported paint file "&nn with "OK"
  choose the pencil tool
  doMenu "Export Paint..."
  popUL
  choose the browse tool
end doExport

on goInfo
  put the short name of this card into nme
  put the name of this bg into tb
  if tb contains "Region" then
    beep
    exit goInfo
  else
    put "I-" & char 3 to 4 of nme into nme
    visual venetian blinds
    go card nme of stack "§Control"
  end if
end goInfo

on goCont
  put the short name of this card into nme
  put "X-" & char 3 to 4 of nme into nme
  visual venetian blinds
  if there is a stack "§Contours" then
    go card nme of stack "§Contours"
  else
    answer "The Contours Data is available in the Registered Version."
  end if
end goCont

on goCit
  put the short name of this card into nme
  put "C-" & char 3 to 4 of nme into nme
  visual venetian blinds
  if there is a stack "§Cities" then
    go card nme of stack "§Cities"
  else
    answer "The Cities Data is available in the Registered Version."
  end if
end goCit

on goReg
  --this is different in control stack, so it has its own
  get bg fld "Region"
  put the short name of this card into sn
  put (char 1 to 2 of sn) & it into crd
  visual iris close slow
  go cd crd
end goReg

on goUSA
  if the short name of this bg contains "Region" then
    put the short name of this cd into tcn
    put prefix(tcn) & "US" into zo
    visual iris close slow
    go cd zo
  else
    go card "US home"of stack "§Control"
  end if
end goUSA

on goComp n   --compass handler
  put item n of bg fld "Compdirs" into place
  if place is not empty then
    go cd place
  else
    beep
  end if
end goComp

on goTop
  put the short name of this card into nme
  put "T-" & char 3 to 4 of nme into nme
  visual venetian blinds
  if there is a stack "§Topography" then
    go card nme of stack "§Topography"
  else
    answer "The Topographical Data is available in the Registered Version."
  end if
end goTop

on doLocate -- locates an item if possible
  global placename
  global maplist
  ask "Place name?" with placename
  if the result is "Cancel" then exit doLocate
  put it into placename
  lock screen
  set the cursor to busy
  put binsearch(placename) into answer
  if answer is empty then
    --do a general find
    find chars placename
    unlock screen
    --answer "Not Found" with "OK"
    exit doLocate
  end if
  unlock screen
  put item 1 of answer into crd
  put item 2 of answer into stk
  put item 3 of answer into x
  put item 4 of answer into y
  if there is a stack stk then
    go cd crd of stack stk
    if the result is not empty then
      answer "Card "&crd&" is missing." with "What?" or "I know"
      exit doLocate
    end if
    set the cursor to hand
    marker x,y
  end if
end doLocate


function binsearch place
--finds place in sorted list by alpha
global maplist,mp,coordlist
lock screen
push cd
go bg "index" of stack "§Control"
find string place in fld "dex"
if the foundline is empty then
  beep
  pop cd
  unlock screen
  exit binsearch
else
  put word 2 of the foundline into lno
  put item 2 of line lno of fld "dex" into maplist
  put item 3 of line lno of fld "dex" into coordlist
  put 2 into mp
  put word 1 of maplist into crd
  pop cd
  unlock screen
end if
put word 1 of coordlist into x
put word 2 of coordlist into y
put char 1 of crd into c
put stkn(c) into stk
return( crd&","&stk&","&x&","&y)
end binsearch



on doFNext  --finds the next location of placeName
  global placeName,maplist,mp,coordlist
  set the cursor to busy
  if placename is empty then
    beep
    exit doFNext
  end if
  if maplist is empty then
    beep
    exit doFNext
  end if
  put the number of words of maplist into n
  if mp>n then
    beep
    exit doFNext
  end if
  put word mp of maplist into crd
  put char 1 of crd into c
  put stkn(c) into stk
  if there is a stack stk then
    go cd crd of stack stk
    put word 2*mp-1 of coordlist into x
    put word 2*mp of coordlist into y
    add 1 to mp
    set the cursor to hand
    marker x,y
  end if
end doFNext

on marker x,y
  set the userlevel to 5
  lock screen
  doMenu "New Button"
  set the name of btn "New Button" to "flash"
  set the rect of btn "flash" to 0,0,15,15
  set the style of btn "flash" to transparent
  set the showname of btn "flash" to false
  set the autohilite of btn "flash" to false
  set the icon of btn "flash" to 1018
  choose browse tool
  popUL
  show cd btn "flash" at x,y
  unlock screen
  set the lockmessages to true
  repeat until the mouseclick
    set the hilite of btn "flash" to not the hilite of btn "flash"
    wait 10
  end repeat
  set the lockmessages to false
  lock screen
  set the userlevel to 5
  choose button tool
  select btn "flash"
  domenu "Cut Button"
  choose browse tool
  popUL
end marker




---------

--handler for adjacent state buttons
--these buttons have no scripts so they fall through to here
on mouseUp
  put getEffect () into visef  --bases this on the clickloc
  put char 2 to 3 of word 3 of the target into xn
  if xn is "OM" then
    pop cd
    exit mouseUp
  end if
  get the short name of this cd
  put char 1 to 2 of it & xn into xn
  visual visef
  go cd xname
end mouseUp


function getEffect  --for adjacent state buttons
put the clickV into cV
put the clickH into cH
put abs(cH - 256) into epsH
put abs(cV - 171) into epsV
if epsV ‚â• epsH then
  if cV ≤ 171 then
    put "Down" into dir
  else
    put "Up" into dir
  end if
else
  if cH ≤ 256 then
    put "Right" into dir
  else
    put "Left" into dir
  end if
end if
return "scroll" && dir && "slow"
end getEffect


--handler for OFF-MAP buttons
on mouseDown
  put char 2 to 3 of word 3 of the target into s
  if s is "OM" then
    push cd
    go cd "ad"
  end if
end mouseDown

function prefix str
return char 1 to 2 of str
end prefix

function suffix str
put the number of chars of str into n
return char 3 to n of str
end suffix



----This is the script for the "Blank" background
----Insert these lines and uncomment them if the script ever gets
----trashed out
--on openCard
--get the short name of this card
--if the first char of it is "B" then
-- hide cd pict
-- visual effect dissolve to black
--go back
--end if
--end openCard






on doEnter
  --enters data on maps and in index
  --not supported
  global thename
  answer "Is the data on the current map?" with "Yes" or "No"
  if it is "No" then
    set the result to -3
    answer "Go to the correct map and try again" with "OK"
    exit doEnter
  end if
  ask "What is the name of the datapoint?" with "nothing"
  if it is "nothing" then
    set the result to -3
    exit doEnter
  end if
  put it into thename
  put the userlevel into ul
  set the userlevel to 5 --(authoring)
  answer "Click near a clear place for the label" with "OK"
  wait until the mouseclick
  answer "Drag label to destination" with "OK"
  choose text tool
  set the textfont to Geneva
  set the textsize to 9
  put the textheight into th
  click at the clickloc
  type name
  choose select tool
  put item 1 of the clickloc into lft
  put item 2 of the clickloc into tp
  subtract th from tp
  subtract 4 from lft
  drag from  lft,tp to (lft + 6*nchar), (tp + th + 3)
  doMenu "Transparent"
  ---
end doEnter

on doClick  --not done
  global indx,indy,thename
  answer "Is this a city location?" with "Yes" or "No"
  --Cities get little black dots, others stuff don't
  put it into ansr
  answer "Please click on the exact location"
  wait until the mouseclick
  put item 1 of the clickloc into indx
  put item 2 of the clickloc into indy
  --insert it in the index, (steal code from home)
end doClick

on popUL
  global USRLVL
  set the userlevel to USRLVL
end popUL


-------Colleen's custom utilities
on doubleEncrypt bgfn,key   --bgfn is the name of a background field
  set the locktext of bg fld bgfn to false
  put bg fld bgfn into temp
  put the number of chars of key into kl
  put encrypt (temp,key,kl) into bg fld bgfn
  set the locktext of bg fld bgfn to true
end doubleEncrypt


function encrypt str,key,kl
put the number of chars of str into nc
put 1 into k
repeat with j = 1 to nc
  set the cursor to busy
  if k > kl then put 1 into k
  put charToNum(char j of str) into n1
  put charToNum(char k of key) into n2
  if n1 <> n2 then put xor(n1,n2) into n2
  put numtoChar(n2) into char j of str
  add 1 to k
end repeat
return str
end encrypt



function xor a,b
put 0 into answer
repeat with i = 0 to 7
  if a >= 2^(7-i) then  --a is,
    if not (b >= 2^(7-i)) then
      add 2^(7-i) to answer
    else
      subtract 2^(7-i) from b
    end if
    subtract 2^(7-i) from a
  else if b >= 2^(7-i) then --b is
    if not (a >= 2^(7-i)) then
      add 2^(7-i) to answer
    else
      subtract 2^(7-i) from a
    end if
    subtract 2^(7-i) from b
  end if
end repeat
return answer
end xor

function enterKey dummy
put empty into key
ask "How many key numbers?"
if it is empty then exit enterKey
put it into kn
repeat with i = 1 to kn
  ask "Carefully enter each key number, then press RETURN"
  if it is empty then
    return ""
  end if
  put numtoChar(it) after key
end repeat
return key
end enterKey


on doDeCrypt
  ask "Enter 2-letter postal code for state to decrypt"
  put "I-"&it into cdn
  go cd cdn of stack "§Control"
  if the result is not empty then
    answer "No such state--try again"
    exit doDeCrypt
  end if
  put enterKey() into key
  if key is empty then exit doDeCrypt
  answer "Please enter key again to verify"
  put enterKey() into vkey
  if it is empty then exit doDeCrypt
  if vkey <> key then
    answer "Key mismatch--try again"
    exit doDeCrypt
  end if
  put bg fld "•lyrics" into lcrypt
  put bg fld "•song data" into scrypt
  doubleEncrypt "•lyrics",key
  doubleEncrypt "•song data",key
  hide cd pict
  show bg fld "•lyrics"
  beep
  answer "Verify:  Is deCryption OK?" with "Yes" or "No"
  if it is "No" then
    put lcrypt into bg fld "•lyrics"
    put scrypt into bg fld "•song data"
  else
    put empty into bg fld "•encrypt"
  end if
end doDeCrypt

on doNewPW
  global SQPW,TCPW  --the two passwords, respectively
  answer "Which Password do you want to change?" with "Quiz Options" or "Score Card"
  put it into tmp
  ask "Old Password?"
  if it is "Cancel" then exit doNewPW
  else put it into OPW
  ask "New Password?"
  if it is "Cancel" then exit doNewPW
  put it into NPW
  if tmp is "Quiz Options" then
    if SQPW = OPW then
      put NPW into SQPW
    else
      beep
      answer "Key mismatch--try again"
    end if
  else
    if TCPW = OPW then
      put NPW into TCPW
    else
      beep
      answer "Key mismatch--try again"
    end if
  end if
end doNewPW


on cleanUSHome
  lock screen
  hide cd fld "State name"
  repeat with i = 2 to 51
    set the cursor to busy
    set the showname of cd btn i to true
  end repeat
  unlock screen
end cleanUSHome